home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / sbin / cups-genppdupdate.5.0 < prev    next >
Encoding:
Text File  |  2007-03-27  |  17.5 KB  |  656 lines
  1. #! /usr/bin/perl -w
  2. # $Id: cups-genppdupdate.in,v 1.25.8.1 2007/03/02 12:01:15 rlk Exp $
  3. # Update CUPS PPDs for Gutenprint queues.
  4. # Copyright (C) 2002-2003 Roger Leigh (rleigh@debian.org)
  5. #
  6. # This program is free software; you can redistribute it and/or modify
  7. # it under the terms of the GNU General Public License as published by
  8. # the Free Software Foundation; either version 2, or (at your option)
  9. # any later version.
  10. #
  11. # This program is distributed in the hope that it will be useful,
  12. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. # GNU General Public License for more details.
  15. #
  16. # You should have received a copy of the GNU General Public License
  17. # along with this program; if not, write to the Free Software
  18. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  19.  
  20. use strict;
  21. use Getopt::Std;
  22. use Fcntl qw(:mode);
  23. use File::Temp qw(:POSIX);
  24. use File::Copy qw(mv);
  25.  
  26. sub parse_options ();
  27. sub update_ppd ($); # Original PPD filename
  28. sub get_ppd_contents ($$$$$); # Return contents of desired PPD
  29. sub find_ppd ($$$$); # Gutenprint Filename, driver, language (e.g. en, sv),
  30.              # region (e.g. GB, DE)
  31. sub get_default_types (*); # Source PPD FH
  32. sub get_defaults (*); # Source PPD FH
  33. sub get_options (*\%); # Source PPD FH, default_types hash ref
  34.  
  35. our $opt_d; # Debug mode
  36. our $opt_h; # Help
  37. our $opt_n; # No action
  38. our $opt_q; # Quiet mode
  39. our $opt_s; # Source PPD location
  40. our $opt_v; # Verbose mode
  41. our $opt_N; # Don't update PPD file options
  42. our $opt_o; # Output directory
  43.  
  44. my $debug = 0;
  45. my $verbose = 0;   # Verbose output
  46. if ($debug) {
  47.     $verbose = 1;
  48. }
  49. my $quiet = 0;     # No output
  50. my $no_action = 0; # Don't output files
  51. my $reset_defaults = 0;        # Reset options to default settings
  52. my $version = "5.0";
  53. my $use_static_ppd = "no";
  54.  
  55. my $ppd_dir = "/etc/cups/ppd"; # Location of in-use CUPS PPDs
  56. my $ppd_root_dir = "/usr/share/ppd";
  57. my $ppd_base_dir = "$ppd_root_dir/gutenprint/$version"; # Available PPDs
  58. my $ppd_out_dir = "";        # By default output into source directory
  59. my $gzext = ".gz";
  60. my $updated_ppd_count = 0;
  61. my $new_ppd_filename;
  62.  
  63. my $serverdir = "/usr/lib/cups";
  64.  
  65. my @ppd_files; # A list of in-use Gutenprint PPD files
  66.  
  67. # Used to convert a language name to its two letter code
  68. my %languagemappings = (
  69.             "chinese"    => "cn",
  70.             "danish"     => "da",
  71.             "dutch"      => "nl",
  72.             "english"    => "en",
  73.             "finnish"    => "fi",
  74.             "french"     => "fr",
  75.             "german"     => "de",
  76.             "greek"      => "el",
  77.             "hungarian"  => "hu",
  78.             "italian"    => "it",
  79.             "japanese"   => "jp",
  80.             "norwegian"  => "no",
  81.             "polish"     => "pl",
  82.             "portuguese" => "pt",
  83.             "russian"    => "ru",
  84.             "slovak"     => "sk",
  85.             "spanish"    => "es",
  86.             "swedish"    => "sv",
  87.             "turkish"    => "tr"
  88. );
  89.  
  90.  
  91. # Check command-line options...
  92.  
  93. parse_options();
  94.  
  95.  
  96. # Set a secure umask...
  97.  
  98. umask 0177;
  99.  
  100.  
  101. # Find all in-use Gutenprint PPD files...
  102.  
  103. my @ppdglob;
  104. if (@ARGV) {
  105.     my $f;
  106.     foreach $f (@ARGV) {
  107.     if (-f $f and ($f =~ /\.ppd$/i or $f =~ /\//)) {
  108.         if (-f $f) {
  109.         push @ppdglob, $f;
  110.         } else {
  111.         print STDERR "Cannot find file $f\n";
  112.         }
  113.     } elsif (-f "$ppd_dir/$f" or
  114.          -f "$ppd_dir/$f.ppd" or
  115.          -f "$ppd_dir/$f.PPD") {
  116.         if (-f "$ppd_dir/$f") {
  117.         push @ppdglob, "$ppd_dir/$f";
  118.         }
  119.         if (-f "$ppd_dir/$f.ppd") {
  120.         push @ppdglob, "$ppd_dir/$f.ppd";
  121.         }
  122.         if (-f "$ppd_dir/$f.PPD") {
  123.         push @ppdglob, "$ppd_dir/$f.PPD";
  124.         }
  125.     }  else {
  126.         print STDERR "Cannot find file $ppd_dir/$f, $ppd_dir/$f.ppd, or $ppd_dir/$f.PPD\n";
  127.     }
  128.     }
  129. } else {
  130.     @ppdglob = glob("$ppd_dir/*.{ppd,PPD}");
  131. }
  132. my $ppdlist = join ' ', @ppdglob;
  133. if (@ppdglob) {
  134.     open PPDFILES, '-|', 'egrep', '-i', '-l', 'Gutenprint|Gimp-Print', @ppdglob or die "can't grep $ppdlist: $!";
  135.     while (<PPDFILES>) {
  136.     chomp;
  137.     push @ppd_files,  $_;
  138.     }
  139.     if (@ppd_files) {
  140.     open PPDFILES, '-|', 'egrep', '-i', '-L', 'Foomatic', @ppd_files or die "can't grep $ppdlist: $!";
  141.     @ppd_files = ();
  142.     while (<PPDFILES>) {
  143.         chomp;
  144.         push @ppd_files,  $_;
  145.     }
  146.     close PPDFILES or ($! == 0) or die "can't close grep pipe: $!";
  147.     }
  148. }
  149.  
  150.  
  151. # Exit if there are not files to update...
  152.  
  153. if (!@ppd_files) {
  154.     print STDOUT "No Gutenprint PPD files to update.\n";
  155.     exit (0);
  156. }
  157.  
  158. # Update each of the Gutenprint PPDs, where possible...
  159.  
  160. foreach (@ppd_files) {
  161.     $updated_ppd_count += update_ppd($_);
  162.  
  163. }
  164.  
  165. if (!$quiet || $verbose) {
  166.     if ($updated_ppd_count > 0) {
  167.     my $plural = "";
  168.     if ($updated_ppd_count != 1) {
  169.         $plural = "s";
  170.     }
  171.     print STDOUT "Updated $updated_ppd_count PPD file${plural}.  Restart cupsd for the changes to take effect.\n";
  172.     exit (0);
  173.     } else {
  174.     print STDOUT "Failed to update any PPD files\n";
  175.     exit (0);
  176.     }
  177. }
  178.  
  179.  
  180.  
  181. sub parse_options () {
  182.     getopts("dhnqs:vNo:");
  183.  
  184.     if ($opt_n) {
  185.     $no_action = 1;
  186.     }
  187.     if ($opt_d) {
  188.     $debug = 1;
  189.     }
  190.     if ($opt_s) {
  191.     if (-d $opt_s) {
  192.         $ppd_base_dir = "$opt_s";
  193.     }
  194.     else {
  195.         die "$opt_s: invalid directory: $!\n";
  196.     }
  197.     }
  198.     if ($opt_v) {
  199.     $verbose = 1;
  200.     $quiet = 0;
  201.     }
  202.     if ($opt_q) {
  203.     $verbose = 0;
  204.     $quiet = 1;
  205.     }
  206.     if ($opt_N) {
  207.     $reset_defaults = 1;
  208.     }
  209.     if ($opt_o) {
  210.     if (-d $opt_o) {
  211.         $ppd_out_dir = "$opt_o";
  212.     }
  213.     else {
  214.         die "$opt_s: invalid directory: $!\n";
  215.     }
  216.     }
  217.     if ($opt_h) {
  218.     print "Usage: $0 [OPTION]... [PPD_FILE]...\n";
  219.     print "Update CUPS+Gutenprint PPD files.\n\n";
  220.         print "  -d          Enable debugging\n";
  221.         print "  -h          Display this help text\n";
  222.     print "  -n          No-action.  Don't overwrite any PPD files.\n";
  223.     print "  -q          Quiet mode.  No messages except errors.\n";
  224.     print "  -s ppd_dir  Use ppd_dir as the source PPD directory.\n";
  225.     print "  -v          Verbose messages.\n";
  226.     print "  -N          Reset options to defaults.\n";
  227.     print "  -o out_dir  Output PPD files to out_dir.\n";
  228.     exit (0);
  229.     }
  230. }
  231.  
  232. sub get_ppd_contents($$$$$) {
  233.     my ($ppd_source_filename, $filename, $driver, $locale, $region) = @_;
  234.  
  235.     my $source_data;
  236.  
  237.  
  238.     if ($use_static_ppd eq "no") {
  239.     my ($driver_bin) = "$serverdir/driver/gutenprint.$version";
  240.     my ($driver_version) = `$driver_bin VERSION`;
  241.     chomp $driver_version;
  242.     if ($driver_version eq "5.0.0.99.1") {
  243.         my ($simplified);
  244.         if ($filename =~ m,.*/([^/]*)(.sim)(.ppd)?(.gz)?$,) {
  245.         $simplified = "simple";
  246.         } else {
  247.         $simplified = "expert";
  248.         }
  249.         my ($url);
  250.         foreach $url ("gutenprint.$version://$driver/$simplified/${locale}_${region}",
  251.               "gutenprint.$version://$driver/$simplified/${locale}",
  252.               "gutenprint.$version://$driver/$simplified") {
  253.         $new_ppd_filename = $url;
  254.         if (open PPD, "$driver_bin cat $url 2>/dev/null |") {
  255.             while (<PPD>) {
  256.             $source_data .= $_;
  257.             }
  258.             close PPD;
  259.             if ($source_data) {
  260.             return $source_data;
  261.             }
  262.         }
  263.         }
  264.     }
  265.     # Otherwise fall through and try to find a static PPD
  266.     }
  267.  
  268.     # Search for a PPD matching our criteria...
  269.  
  270.     $new_ppd_filename = find_ppd($filename, $driver, $locale, $region);
  271.     if (!defined($new_ppd_filename)) {
  272.         # There wasn't a valid source PPD file, so give up.
  273.         print STDERR "$ppd_source_filename: no valid candidate for replacement.  Skipping\n";
  274.         print STDERR "$ppd_source_filename: please upgrade this PPD manually\n";
  275.     return 0;
  276.     }
  277.     if ($debug) {
  278.     print "Candidate PPD: $new_ppd_filename\n";
  279.     }
  280.  
  281.     my $suffix = "\\" . $gzext; # Add '\', so m// matches the '.'.
  282.     if ($new_ppd_filename =~ m/.gz$/) { # Decompress input buffer
  283.     open GZIN, "gunzip -c $new_ppd_filename |"
  284.         or die "$_: can't open for decompression: $!";
  285.     while (<GZIN>) {
  286.         $source_data .= $_;
  287.     }
  288.     close GZIN;
  289.     } else {
  290.     open SOURCE, $new_ppd_filename
  291.         or die "$new_ppd_filename: can't open source file: $!";
  292.     binmode SOURCE;
  293.     my $source_size = (stat(SOURCE))[7];
  294.     read (SOURCE, $source_data, $source_size)
  295.         or die "$new_ppd_filename: error reading source: $!";
  296.     close SOURCE or die "$new_ppd_filename: can't close file: $!";
  297.     }
  298.     return $source_data;
  299. }
  300.  
  301. # Update the named PPD file.
  302. sub update_ppd ($) {
  303.     my $ppd_source_filename = $_;
  304.     my $ppd_dest_filename = $ppd_source_filename;
  305.     if ($ppd_out_dir) {
  306.     $ppd_dest_filename =~ s;(.*)/([^/]+);$2;;
  307.     $ppd_dest_filename = "$ppd_out_dir/$ppd_dest_filename";
  308.     }
  309.  
  310.     open ORIG, $_ or die "$_: can't open PPD file: $!";
  311.     seek (ORIG, 0, 0) or die "can't seek to start of PPD file";
  312.     my @orig_metadata = stat(ORIG);
  313.     if ($debug) {
  314.     print "Source Filename: $ppd_source_filename\n";
  315.     }
  316.     my ($filename) = "";
  317.     my ($driver) = "";
  318.     my ($gutenprintdriver) = "";
  319.     my ($locale) = "";
  320.     my ($lingo) = "";
  321.     my ($region) = "";
  322.     my ($valid) = 0;
  323.     while (<ORIG>) {
  324.     if (/\*StpLocale:/) {
  325.         ($locale) = m/^\*StpLocale:\s\"*(.*)\"$/;
  326.         $valid = 1;
  327.     }
  328.     if (/\*LanguageVersion/) {
  329.         ($lingo) = m/^\*LanguageVersion:\s*(.*)$/;
  330.     }
  331.     if (/^\*StpDriverName:/ ) {
  332.         ($driver) = m/^\*StpDriverName:\s*\"(.*)\"$/;
  333.         $valid = 1;
  334.     }
  335.     if (/\*%End of / && $driver eq "") {
  336.         ($driver) = m/^\*%End of\s*(.*).ppd$/;
  337.     }
  338.     if (/^\*StpPPDLocation:/ ) {
  339.         ($filename) = m/^\*StpPPDLocation:\s*\"(.*)\"$/;
  340.         $valid = 1;
  341.     }
  342.     if (/^\*%Gutenprint Filename:/) {
  343.         $valid = 1;
  344.     }
  345.     }
  346.     if (! $valid) {
  347.     print STDERR "$ppd_source_filename: this PPD file cannot be upgraded automatically (only files based on Gutenprint 4.3.21 and newer can be)\n";
  348.     return 0;
  349.     }
  350.     if ($debug) {
  351.     print "Gutenprint Filename: $filename\n";
  352.     print "Locale: $locale\n";
  353.     print "Language: $lingo\n";
  354.     print "Driver: $driver\n";
  355.     }
  356.     if ($locale) {
  357.     # Split into the language and territory.
  358.     ($locale, $region) = split(/-/, $locale);
  359.     } else {
  360.     # Split into the language and territory.
  361.     ($locale, $region) = split(/-/, $lingo);
  362.     # Convert language into language code.
  363.     $locale = $languagemappings{"\L$lingo"};
  364.     if (!defined($locale)) {
  365.         $locale = "C"; # Fallback if there isn't one.
  366.     }
  367.     }
  368.     if (! defined($region)) {
  369.     $region = "";
  370.     }
  371.     if ($debug) {
  372.     print "Locale: $locale\n";
  373.     print "Region: $region\n";
  374.     }
  375.  
  376.     # Read in the new PPD, decompressing it if needed...
  377.  
  378.     my $source_data = get_ppd_contents($ppd_source_filename, $filename,
  379.                        $driver, $locale, $region);
  380.  
  381.     if (! $source_data) {
  382.     die "Unable to retrieve PPD file!\n";
  383.     }
  384.  
  385.     # Save new PPD in a temporary file, for processing...
  386.  
  387.     my($tmpfile, $tmpfilename) = tmpnam();
  388.     unlink $tmpfilename or warn "can't unlink temporary file $tmpfile: $!\n";
  389.     print $tmpfile $source_data;
  390.  
  391.  
  392.  
  393.  
  394.     # Extract the default values from the original PPD...
  395.  
  396.     my %orig_default_types = get_default_types(ORIG);
  397.     my %new_default_types = get_default_types($tmpfile);
  398.     my %defaults = get_defaults(ORIG);
  399.     my %options = get_options($tmpfile, %new_default_types);
  400.  
  401.  
  402.     # Close original and temporary files...
  403.  
  404.     close ORIG or die "$_: can't close file: $!";
  405.     close $tmpfile or die "can't close temporary file $tmpfile: $!";
  406.  
  407.  
  408.     if ($debug) {
  409.     print "Original Default Types:\n";
  410.     foreach (sort keys %orig_default_types) {
  411.         print "  $_: $orig_default_types{$_}\n";
  412.     }
  413.     print "New Default Types:\n";
  414.     foreach (sort keys %new_default_types) {
  415.         print "  $_: $new_default_types{$_}\n";
  416.     }
  417.     print "Defaults:\n";
  418.     foreach (sort keys %defaults) {
  419.         print "  $_: $defaults{$_}\n";
  420.     }
  421.     print "Options:\n";
  422.     foreach (sort keys %options) {
  423.         print "  $_:  ";
  424.         foreach my $opt (@{$options{$_}}) {
  425.         print "$opt ";
  426.         }
  427.         print "\n";
  428.     }
  429.  
  430.     }
  431.  
  432.     if  (! $reset_defaults) {
  433.     # Update source buffer with old defaults...
  434.  
  435.     # Loop through each default in turn.
  436. default_loop:
  437.     foreach (sort keys %defaults) {
  438.         my $default_option = $_;
  439.         my $option;
  440.         ($option = $_) =~ s/Default//; # Strip off `Default'
  441.         # Check method is valid
  442.         my $orig_method = $orig_default_types{$option};
  443.         my $new_method = $new_default_types{$option};
  444.         if ((!defined($orig_method) || !defined($new_method)) ||
  445.         $orig_method ne $new_method) {
  446.         next;
  447.         }
  448.         if ($new_method eq "PickOne") {
  449.         # Check the old setting is valid
  450.         foreach (@{$options{$option}}) {
  451.             if ($defaults{$default_option} eq $_) { # Valid option
  452.             # Set the option in the new PPD
  453.             $source_data =~ s/\*($default_option).*/*$1:$defaults{$default_option}/m;
  454.             if ($verbose) {
  455.                 print "$ppd_source_filename: Set *$default_option to $defaults{$default_option}\n";
  456.             }
  457.             next default_loop;
  458.             }
  459.         }
  460.         warn "Warning: $ppd_source_filename: Invalid option: *$default_option: $defaults{$default_option}.  Using default setting.\n";
  461.         next;
  462.         }
  463.         warn "Warning: $ppd_source_filename: PPD OpenUI method $new_default_types{$_} not understood.\n";
  464.     }
  465.     }
  466.  
  467.     # Write new PPD...
  468.  
  469.     my $tmpnew = "${ppd_dest_filename}.new";
  470.     if (! open NEWPPD, "> $tmpnew") {
  471.     warn "Can't open $tmpnew for writing: $!\n";
  472.     return 0;
  473.     }
  474.     print NEWPPD $source_data;
  475.     if (! close NEWPPD) {
  476.     warn "Can't close ${tmpnew}.new for writing: $!\n";
  477.     unlink $tmpnew;
  478.     return 0;
  479.     }
  480.  
  481.     if (! rename $tmpnew, $ppd_dest_filename) {
  482.     warn "Can't rename $tmpnew to $ppd_dest_filename: $!\n";
  483.     unlink $tmpnew;
  484.     return 0;
  485.     }
  486.     chown($orig_metadata[4], $orig_metadata[5], $ppd_dest_filename);
  487.     chmod(($orig_metadata[2] & 0777), $ppd_dest_filename);
  488.  
  489.     if (!$quiet || $verbose) {
  490.     if ($ppd_dest_filename eq $ppd_source_filename) {
  491.         print STDOUT "Updated $ppd_source_filename using $new_ppd_filename\n";
  492.     } else {
  493.         print STDOUT "Updated $ppd_source_filename to $ppd_dest_filename using $new_ppd_filename\n";
  494.     }
  495.     }
  496.     return 1;
  497.     # All done!
  498. }
  499.  
  500. # Find a suitable source PPD file
  501. sub find_ppd ($$$$) {
  502.     my($gutenprintfilename, $drivername, $lang, $region) = @_;
  503.     my $file; # filename to return
  504.     my ($key) = '^\\*FileVersion:[     ]*"5.0.0.99.1"$';
  505.     my ($lingo, $suffix, $base, $basedir);
  506.     my ($current_best_file, $current_best_time);
  507.     my ($stored_name, $stored_dir, $simplified);
  508.     $stored_name = $gutenprintfilename;
  509.     $stored_name =~ s,.*/([^/]*)(.sim)?(.ppd)?(.gz)?$,$1,;
  510.     if ($gutenprintfilename =~ m,.*/([^/]*)(.sim)(.ppd)?(.gz)?$,) {
  511.     $simplified = ".sim";
  512.     } else {
  513.     $simplified = "";
  514.     }
  515.     $stored_dir = $gutenprintfilename;
  516.     $stored_dir =~ s,(.*)/([^/]*)$,$1,;
  517.  
  518.     $current_best_file = "";
  519.     $current_best_time = 0;
  520.  
  521.     # All possible candidates, in order of usefulness and gzippedness
  522.     foreach $lingo ("${lang}_${region}/",
  523.             "$lang/",
  524.             "en/",
  525.             "C/",
  526.             "") {
  527.     foreach $suffix (".ppd$gzext",
  528.              ".ppd") {
  529.         foreach $base ("${drivername}.$version${simplified}",
  530.                            "stp-${drivername}.$version${simplified}",
  531.                $stored_name,
  532.                $drivername) {
  533.         foreach $basedir ($ppd_base_dir,
  534.                   $stored_dir,
  535.                   $ppd_root_dir) {
  536.                     if (! $basedir || ! $base) { next; }
  537.             my ($fn) = "$basedir/$lingo$base$suffix";
  538.             if ($debug) {
  539.                         print "Trying $fn for $gutenprintfilename, $lang, $region\n";
  540.                     }
  541. # Check that it is a regular file, owned by root.root, not writable
  542. # by other, and is readable by root.  i.e. the file is secure.
  543.             my @sb = stat $fn or next;
  544.             if (S_ISREG($sb[2]) && ($sb[4] == 0)) {
  545.             # Check that the file is a valid Gutenprint PPD file
  546.             # of the correct version.
  547.             my $file_version;
  548.             if ($fn =~ m/\.gz$/) {
  549.                 $file_version = `gunzip -c $fn | grep '$key'`;
  550.             } else {
  551.                 $file_version = `cat $fn | grep '$key'`;
  552.             }
  553.             if ($file_version ne "") {
  554.                             if ($debug) {
  555.                     print "   Format valid: time $sb[9] best $current_best_time prev $current_best_file cur $fn!\n";
  556.                 }
  557.                 if ($sb[9] > $current_best_time) {
  558.                 $current_best_time = $sb[9];
  559.                 $current_best_file = $fn;
  560.                         if ($debug) {
  561.                                     print STDERR "***current_best_file is $fn\n";
  562.                                 }
  563.                 }
  564.             } elsif ($debug) {
  565.                 print "   Format invalid\n";
  566.             }
  567.             }
  568.             else {
  569.             $_ = $fn;
  570.             if (! -d $fn && ! /\/$/) {
  571.                 print STDERR "$fn: not a regular file, or insecure ownership and permissions.  Skipped\n";
  572.             }
  573.             }
  574.         }
  575.         }
  576.     }
  577.     }
  578.     if ($current_best_file) {
  579.         return $current_best_file;
  580.     }
  581. # Yikes!  Cannot find a valid PPD file!
  582.     return undef;
  583. }
  584.  
  585. # Return the default options from the given PPD filename
  586. sub get_default_types(*) {
  587.     my $fh = $_[0];
  588.     my %default_types;
  589.  
  590.     # Read each line of the original PPD file, and store all OpenUI
  591.     # names and their types in a hash...
  592.     seek ($fh, 0, 0) or die "can't seek to start of PPD file";
  593.     while (<$fh>) {
  594.     if ( m/^\*OpenUI/ ) {
  595.         chomp;
  596.         my ($key, $value) = /^\*OpenUI\s\*([[:alnum:]]+).*:\s([[:alnum:]]+)/;
  597.         if ($key && $value) {
  598.         $default_types{$key}=$value;
  599.         }
  600.     }
  601.     }
  602.     return %default_types;
  603. }
  604.  
  605.  
  606. # Return the default options from the given PPD filename
  607. sub get_defaults(*) {
  608.     my $fh = $_[0];
  609.     my %defaults;
  610.  
  611.     # Read each line of the original PPD file, and store all default
  612.     # names and their values in a hash...
  613.     seek ($fh, 0, 0) or die "can't seek to start of PPD file";
  614.     while (<$fh>) {
  615.     if ( m/^\*Default/ ) {
  616.         chomp;
  617.         my($key, $value) = /^\*([[:alnum:]]+):\s*([[:alnum:]]+)/;
  618.         if ($key && $value) {
  619.         $defaults{$key}=$value;
  620.         }
  621.     }
  622.     }
  623.     return %defaults;
  624. }
  625.  
  626.  
  627. # Return the available options from the given PPD filename
  628. sub get_options(*\%) {
  629.     my $fh = $_[0];
  630.     my $validopts = $_[1];
  631.     my %options;
  632.  
  633.     # For each valid option name, grab each valid option for that name
  634.     # and store in a hash of arrays...
  635.  
  636.     foreach (sort keys %$validopts) {
  637.     my $tmp = $_;
  638.     my @optionlist;
  639.  
  640.     seek ($fh, 0, 0) or die "can't seek to start of PPD file";
  641.     while (<$fh>) {
  642.         if ( m/^\*$tmp/ ) {
  643.         chomp;
  644.         my ($value) = /^\*$tmp\s*([[:alnum:]]+)[\/:]/;
  645.         if ($value) {
  646.             push @optionlist, $value;
  647.         }
  648.         }
  649.     }
  650.     if (@optionlist) {
  651.         $options{$tmp} = [ @optionlist ];
  652.     }
  653.     }
  654.     return %options;
  655. }
  656.